home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 163 / 163.d81 / lunar locator (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  3KB  |  103 lines
  1. 5 poke55,.:poke56,56:clr
  2. 10 dv=peek(186):ifdv<8thendv=8
  3. 12 poke53371,0:poke53272,31
  4. 15 print"[147]":poke53280,0:poke53281,0
  5. 27 ad=49152
  6. 28 sysad:sysad+12
  7. 29 sysad+9,0
  8. 62 sysad+9,1
  9. 65 p2=2*(NULL):rem radians in a full circle
  10. 70 print"[147]"
  11. 75 bs$="[150][164][157][164][157][164][157][164][157][164][157][164][157][164][157][164][157][164][157][164][157][164][157][164][157][164][157][164][157][164][157][164][157][164][157][164][157][164][157][164][157][164][157][164]"
  12. 80 print"[150][220][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][221]"
  13. 85 printbs$""tab(38)bs$
  14. 90 print"[150][255][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][161]"
  15. 95 print""tab(6)"[150]-[159][204] [213] [206] [193] [210]   [204] [207] [195] [193] [212] [207] [210][150]-"
  16. 100 print:printtab(5)"[158][197]nter [217]ear (e.g. 1998): ";:l9%=4:gosub375:y=q9
  17. 102 sysad+9,2
  18. 105 printtab(7)"[158][197]nter [205]onth (1 - 12): ";:l9%=2:gosub375:m=q9
  19. 110 ifm>12thenprint"[145][145]":goto105
  20. 112 sysad+9,2
  21. 115 printtab(9)"[158][197]nter [196]ay (1 - 31): ";:l9%=2:gosub375:d=q9
  22. 120 ifd>31thenprint"[145][145]":goto115
  23. 122 sysad+9,2
  24. 125 poke214,6:print:printtab(8)"[150][201]s this [195]orrect? (y[150]/n[150])":poke198,.
  25. 130 gosub535
  26. 135 ifa$="n"then62
  27. 137 sysad+9,3
  28. 140 yy=y-int((12-m)/10)
  29. 145 mm=m+9:ifmm>=12then mm=mm-12
  30. 150 k1=int(365.25*(yy+4712))
  31. 155 k2=int(30.6*mm+.5)
  32. 160 k3=int(int((yy/100)+49)*.75)-38
  33. 165 j=k1+k2+d+59
  34. 170 ifj>2299160thenj=j-k3
  35. 175 rem j is julian date at 12h ut on day in question
  36. 185 rem calculate illumination (synodic) phase
  37. 190 v=(j-2451550.1)/29.530588853:gosub360:ip=v
  38. 195 ag=ip*29.53
  39. 200 ip=ip*p2
  40. 210 rem calculate distance from anomalistic phase
  41. 215 v=(j-2451562.2)/27.55454988:gosub360:dp=v
  42. 220 dp=dp*p2
  43. 225 di=60.4-3.3*cos(dp)-.6*cos(2*ip-dp)-.5*cos(2*ip)
  44. 235 rem calculate latitude from nodal (draconic) phase
  45. 240 v=(j-2451565.2)/27.212220817:gosub360:np=v
  46. 245 np=np*p2
  47. 250 la=5.1*sin(np)
  48. 260 rem calculate longitude from sidereal motion
  49. 265 v=(j-2451555.8)/27.321582241:gosub360:rp=v
  50. 270 l0=360*rp+6.3*sin(dp)+1.3*sin(2*ip-dp)+.7*sin(2*ip)
  51. 275 poke214,6:print:printtab(1)"[156][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162]"
  52. 280 poke214,7:print:printtab(5)"[150]-[159][205][207][207][206]'[211] [193][199][197] [193][206][196] [208][207][211][201][212][201][207][206][150]-"
  53. 285 print:printtab(2)"[153][193]ge from [206]ew [154](days):[158]";ag:gosub470
  54. 290 print:printtab(2)"[153][196]istance [154]([197]arth radii):[158]";di
  55. 295 printtab(2)"[153][196]istance [154](in kms):[158]";(di*6378)-900
  56. 300 print:printtab(2)"[153][197]cliptic latitude:[158]";la;"[219]"
  57. 305 printtab(2)"[153][197]cliptic longitude:[158]";l0;"[219]"
  58. 310 ifla>-1andla<1andag>14andag<15thengosub515
  59. 315 ifla>-1andla<1andag>=29andag<1thengosub525
  60. 320 gosub3000
  61. 330 goto62
  62. 360 rem normalize values to range 0 to 1
  63. 365 v=v-int(v):ifv<0then v=v+1
  64. 370 return
  65. 375 q9$="":poke198,.
  66. 380 geta$
  67. 385 poke646,rnd(1)*15+1:print"*[157]";:ifa$=""then380
  68. 390 ifa$=chr$(13)thenprint" ":q9=val(q9$):return
  69. 395 if(a$=chr$(20)andlen(q9$))thenq9$=left$(q9$,len(q9$)-1):goto417
  70. 400 iflen(q9$)>=l9%thensysad+9,2:goto380
  71. 405 if(a$>="0"anda$<="9")then410
  72. 407 goto380
  73. 410 q9$=q9$+a$
  74. 415 print""a$;:goto380
  75. 417 print" [157][157] [157]";:goto380
  76. 470 ifag>6.4andag<=8.2thenprinttab(6)"[159]1st [209]uarter [205]oon.  [173]"
  77. 475 ifag>8.2andag<13.5thenprinttab(6)"[159][205]oon is [215]axing.  [183]"
  78. 480 ifag>13.5andag<=15.5thenprinttab(6)"[159][198]ull [205]oon tonight!  [181][182]"
  79. 485 ifag>=15.51andag<20.6thenprinttab(6)"[159][205]oon is [215]aning.  [183]"
  80. 490 ifag>=20.7andag<23.2thenprinttab(6)"[159]3rd [209]uarter [205]oon.  [172]"
  81. 495 ifag>23.2andag<28.4thenprinttab(6)"[159][205]oon is [215]aning.  ("
  82. 500 ifag>=28.4orag<.55thenprinttab(6)"[159][206]ew [205]oon tonight!  [144][170][171]"
  83. 505 ifag>.56andag<6.4thenprinttab(6)"[159][205]oon is [215]axing.  )"
  84. 510 return
  85. 515 poke214,18:print:printtab(3)"[204][213][206][193][210] [197][195][204][201][208][211][197] somewhere on [197]arth."
  86. 520 return
  87. 525 poke214,18:print:printtab(3)"[211][207][204][193][210] [197][195][204][201][208][211][197] somewhere on [197]arth."
  88. 530 return
  89. 535 poke198,0
  90. 536 geta$
  91. 537 ifa$<>"y"anda$<>"n"then536
  92. 540 return
  93. 3000 poke214,19:print:printtab(8)"[150](1[150]) [195]alculate another
  94. 3010 [153][163]8)"def(2def) (NULL)o (NULL)(NULL)right$(NULL)val(NULL)(NULL)val (NULL)enu
  95. 3020 poke198,0
  96. 3030 geta$:ifa$<"1"ora$>"2"then3030
  97. 3040 ifa$="1"thenreturn
  98. 3050 sysad+15
  99. 3060 print"[147]load"chr$(34)"b.universe"chr$(34)","dv
  100. 3070 print"run28"
  101. 3080 poke631,13:poke632,13:poke198,2:end
  102. 10000 d=peek(186):n$="lunar locator":open15,d,15,"s0:"+n$:close15:saven$,d:end
  103.